home *** CD-ROM | disk | FTP | other *** search
/ Software Vault: The Diamond Collection / The Diamond Collection (Software Vault)(Digital Impact).ISO / cdr28 / subexa.zip / SUBEXAMP.PRG < prev   
Text File  |  1994-12-16  |  3KB  |  138 lines
  1. *******************************************************************
  2. *
  3. * Funktion    : START()
  4. * Copyright   : (c) 1993-1994, Peter Huff
  5. *               Alle Rechte vorbehalten
  6. *
  7. * Datum       : 28.11.93
  8. * Autor       : Peter Rainer Huff
  9. * Beschreibung: Beispielprogramm für das Anlegen eines Verzeichnis 
  10. *            mit mehreren Unterverzeichnissen
  11. *
  12. * Rückgabe    : NIL
  13. *
  14. *******************************************************************
  15.  
  16. #define    FALSE           .F.   
  17. #define    TRUE            .T.   
  18. #define    SC_NONE          0
  19.  
  20. FUNCTION START()
  21.  
  22.     LOCAL newdir := "C:\DATA\PROJECT\AIRPORT\FOYER\"
  23.  
  24.     CLS
  25.  
  26.     ?  "   (c) Peter Huff, Germany, Version 1.0"
  27.     ?  "   All Rights reserved."
  28.     ?  "   Create a directory with some subdirectories (Written with FUNCky II)."  
  29.     ?
  30.     ?  "   Name      :    MVERZ()"
  31.     ?  "   Usage     :    MVERZ(dirname)  --> Status"
  32.     ?  "   Example   :    MVERZ('C:\DATA\PROJECT\AIRPORT\FOYER\')"
  33.  
  34.     IF RIGHT(ALLTRIM(newdir),1) # "\"
  35.        newdir := ALLTRIM(newdir) 
  36.     ELSE
  37.        newdir := LEFT(ALLTRIM(newdir),LEN(ALLTRIM(newdir))-1)
  38.     ENDIF
  39.  
  40.     IF ISDIR(newdir)
  41.        MESSBOX("Directory already exists :;;" + UPPER(newdir))
  42.     ELSE
  43.        IF   !  MVERZ(newdir)
  44.               MESSBOX("Error creating directory :;;" + UPPER(newdir))
  45.        ELSE
  46.               MESSBOX("Directory has been created :;;" + UPPER(newdir))
  47.        ENDIF
  48.     ENDIF
  49.  
  50. RETURN(NIL)
  51.  
  52.  
  53. *******************************************************************
  54. *
  55. * Funktion    : MVERZ()
  56. * Copyright   : (c) 1993-1994, Peter Huff
  57. *               Alle Rechte vorbehalten
  58. * Datum       : 3.06.93
  59. * Autor       : Peter Rainer Huff
  60. * Beschreibung: Anlegen eines Unterverzeichnis
  61. *               
  62. * Rückgabe    : retval (Status .T. oder .F. )
  63. *******************************************************************
  64.  
  65. FUNCTION MVERZ(newdir)
  66.  
  67.     LOCAL i         :=  1 
  68.     LOCAL occur     :=  {}  
  69.     LOCAL dir       :=  ""  
  70.     LOCAL retval    :=  .T.
  71.     LOCAL old_path  :=  CURDRIVE() + "\" + CURDIR() 
  72.  
  73.     IF RIGHT(ALLTRIM(newdir),1) # "\"
  74.        newdir := ALLTRIM(newdir) + "\"
  75.     ELSE
  76.        newdir := ALLTRIM(newdir)
  77.     ENDIF
  78.  
  79.     FOR i:= 1 TO CHRTOTAL(newdir,"\")
  80.          AADD(occur, ATNEXT("\",newdir,i))
  81.     NEXT
  82.  
  83.     CHDIR("\")
  84.  
  85.     FOR i := 1 TO LEN(occur)
  86.         IF ( i == LEN(occur) )
  87.            EXIT
  88.         ENDIF 
  89.  
  90.         dir := dir + "\"+SUBSTR(newdir,occur[i]+1,occur[i+1]-1-occur[i])
  91.  
  92.         IF ! MKDIR(SUBSTR(newdir,occur[i]+1,occur[i+1]-1-occur[i]))
  93.            IF ( i == (LEN(occur)-1) )
  94.               retval := FALSE
  95.            ENDIF
  96.         ELSE
  97.            retval := TRUE
  98.         ENDIF 
  99.      
  100.         CHDIR(dir)    
  101.  
  102.     NEXT i
  103.  
  104.     CHDIR(old_path)  // Der alte Pfad wird wieder eingestellt
  105.    
  106. RETURN(retval)
  107.  
  108.  
  109. *******************************************************************
  110. *
  111. * Funktion    : MESSBOX
  112. * Copyright   : (c) 1993-1994, Peter Huff
  113. *               Alle Rechte vorbehalten
  114. *
  115. * Datum       : 28.11.93
  116. * Autor       : Peter Rainer Huff
  117. * Beschreibung: 
  118. *
  119. * Rückgabe    : NIL
  120. *
  121. *******************************************************************
  122.  
  123. FUNCTION MESSBOX(mess)
  124.  
  125.     LOCAL  _mm 
  126.     LOCAL  _ao
  127.     LOCAL  cursstate := SETCURSOR()
  128.  
  129.     SETCURSOR(SC_NONE)
  130.  
  131.     _ao  :=  {}
  132.     _mm  :=  ALERT(mess, _ao)
  133.  
  134.     SETCURSOR(cursstate)
  135.  
  136. RETURN(NIL)
  137.  
  138. *---Eof